﻿
Imports System.Reflection
#If Not PocketPC AndAlso Not Smartphone Then
Imports System.Reflection.Emit
Imports System.Runtime.InteropServices
#End If

Public Module netapi

    Private Delegate Function matchNamespaceClassDelegate(ByVal name_space As String, ByVal className As String, _
                                                          ByVal obj1 As Object, ByVal obj2 As Object) As Boolean

    Private Function _matchNameSpaceClass(ByVal name_space As String, ByVal className As String, _
                                          ByVal inputNS As String, ByVal inputC As String) As Boolean
        Return strsame(name_space, inputNS, False) AndAlso _
               strsame(className, inputC, False)
    End Function

    Private Function _matchNameSpaceClass(ByVal name_space As String, ByVal className As String, _
                                          ByVal obj1 As Object, ByVal obj2 As Object) As Boolean
        Return _matchNameSpaceClass(name_space, className, _
                                    convertor.cast(Of String)(obj1), convertor.cast(Of String)(obj2))
    End Function

    Private Function _matchNameSpaceClassCombine(ByVal name_space As String, ByVal className As String, _
                                                 ByVal input As String, ByVal __NOT_IN_USE__ As Object) As Boolean
        Return strsame(name_space + character.dot + className, input, False)
    End Function

    Private Function _matchNameSpaceClassCombine(ByVal name_space As String, ByVal className As String, _
                                                 ByVal obj1 As Object, ByVal obj2 As Object) As Boolean
        Return _matchNameSpaceClassCombine(name_space, className, convertor.cast(Of String)(obj1), obj2)
    End Function

    Private Function _loadassembly(ByVal fullpath As String, ByRef assem As Assembly) As Boolean
        On Error Resume Next
#If Not PocketPC AndAlso Not Smartphone Then
        AppDomain.CurrentDomain.SetupInformation.PrivateBinPath += filesystem.pathSeperator + parentpath(fullpath)

        'Warning(17)  'Public Sub AppendPrivatePath(path As String)' is obsolete: 
        'AppDomain.AppendPrivatePath has been deprecated. 
        'Please investigate the use of AppDomainSetup.PrivateBinPath instead. 
        'http://go.microsoft.com/fwlink/?linkid=14202'.
        'AppDomain.CurrentDomain.AppendPrivatePath(parentpath(fullpath))
#End If
        assem = Assembly.LoadFrom(fullpath)
        Return Not assem Is Nothing
    End Function

    Public Function loadassembly(ByVal filename As String, ByRef assem As Assembly) As Boolean
        Dim i As Int64
        Dim s() As String = Nothing
        searchpaths(filename, s)
        For i = 0 To s.Length() - 1
            If _loadassembly(s(i), assem) Then
                Return True
            End If
        Next
        Return False
    End Function

    Private Function _loadclass(ByVal filename As String, ByVal input1 As Object, _
                                ByVal input2 As Object, ByRef t As Type, _
                                ByVal match As matchNamespaceClassDelegate) As Boolean
        On Error Resume Next
        Dim assem As Assembly = Nothing
        Dim types As Type() = Nothing
        If loadassembly(filename, assem) Then
            types = assem.GetTypes()
            Dim i As Int32
            For i = 0 To types.Length() - 1
                If match(types(i).Namespace, types(i).Name, input1, input2) Then
                    t = types(i)
                    Exit For
                End If
            Next

            If t Is Nothing Then
                raiseError("failed to load managed dll from " + filename + ", input1 = " + Convert.ToString(input1) + _
                           ", input2 = " + Convert.ToString(input2), errorHandle.errorType.warning)
                Return False
            Else
                Return True
            End If
        Else
            raiseError("failed to load assembly from managed dll " + filename, errorHandle.errorType.warning)
            Return False
        End If
    End Function

    Public Function loadclass(ByVal filename As String, ByVal name_space As String, _
                              ByVal className As String, ByRef t As Type) As Boolean
        Return _loadclass(filename, name_space, className, t, AddressOf _matchNameSpaceClass)
    End Function

    Public Function loadclass(ByVal filename As String, ByVal className As String, ByRef t As Type) As Boolean
        Return _loadclass(filename, className, Nothing, t, AddressOf _matchNameSpaceClassCombine)
    End Function

#If Not PocketPC AndAlso Not Smartphone Then
    Public Function loadmethod(Of delegateType)(ByVal fileName As String, ByVal name_space As String, _
                                                ByVal className As String, ByVal procName As String, _
                                                ByRef method As [Delegate]) As Boolean
        Dim m As Reflection.MethodInfo = Nothing
        If loadmethod(fileName, name_space, className, procName, m) Then
            Try
                method = [Delegate].CreateDelegate(GetType(delegateType), m)
            Catch ex As Exception
                raiseError("can not create delegate for method from managed dll from " + fileName + _
                           ", namespace = " + name_space + ", classname = " + className + ", procname = " + procName + _
                           ", ex " + ex.Message, _
                           errorHandle.errorType.warning)
                Return False
            End Try
            Return Not method Is Nothing
        Else
            Return False
        End If
    End Function

    Public Function loadmethod(ByRef fileName As String, ByRef procName As String, ByRef method As [Delegate], _
                               ByRef returnType As Type, ByRef libHandle As IntPtr) As Boolean
        On Error Resume Next
        Dim extCode As Boolean = False
        Dim farproc As IntPtr = IntPtr.Zero
        Dim assBd As AssemblyBuilder = Nothing
        Dim procBd As ModuleBuilder = Nothing
        libHandle = loadlibrary(fileName)
        If libHandle = IntPtr.Zero Then
            libHandle = loadlibraryA(fileName)
        End If

        If libHandle = IntPtr.Zero Then
            raiseError("dll file is not loadable [missing or bad formatted], dllName = " + _
                        fileName, errorHandle.errorType.critical)
            extCode = False
        Else
            farproc = getprocAddress(libHandle, procName)
            If farproc = IntPtr.Zero Then
                raiseError("method no found, procName = " + procName + ", dllName = " + fileName, _
                            errorHandle.errorType.critical)
                extCode = False
            Else
                method = Marshal.GetDelegateForFunctionPointer(farproc, returnType)
                extCode = True
            End If
        End If

        Return extCode
    End Function
#End If

    Public Function loadmethod(ByVal t As Type, ByVal name As String, ByRef output As Reflection.MethodInfo) As Boolean
        If t Is Nothing Then
            Return False
        Else
            Try
                output = t.GetMethod(name)
            Catch
                Return False
            End Try

            Return Not output Is Nothing
        End If
    End Function

    Public Function loadmethod(ByVal name As String, ByRef output As Reflection.MethodInfo) As Boolean
        Dim typename As String = Nothing
        Dim funcname As String = Nothing
        If Not strrseg(name, typename, funcname, character.dot) Then
            Return False
        Else
            Dim t As Type = Nothing
            Try
                t = Type.GetType(typename)
            Catch
                Return False
            End Try
            Return loadmethod(t, funcname, output)
        End If
    End Function

    Public Function loadmethod(ByVal fileName As String, ByVal name_space As String, _
                               ByVal className As String, ByVal procName As String, _
                               ByRef m As Reflection.MethodInfo) As Boolean
        Dim t As Type = Nothing
        If Not loadclass(fileName, name_space, className, t) OrElse Not loadmethod(t, procName, m) Then
            raiseError("failed to load managed dll from " + fileName + ", namespace = " + _
                       name_space + ", classname = " + className + ", procname = " + procName, _
                       errorHandle.errorType.warning)
            Return False
        End If
        Return Not m Is Nothing
    End Function

    Public Function loadmethod(ByVal filename As String, ByVal className As String, ByVal procName As String, _
                               ByRef m As Reflection.MethodInfo) As Boolean
        Dim t As Type = Nothing
        If Not loadclass(filename, className, t) OrElse Not loadmethod(t, procName, m) Then
            raiseError("failed to load managed dll from " + filename + ", classname = " + className + _
                       ", procname = " + procName, _
                       errorHandle.errorType.warning)
            Return False
        End If
        Return Not m Is Nothing
    End Function

    Public Function loadmethod(ByVal filename As String, ByVal procname As String, _
                               ByRef m As Reflection.MethodInfo) As Boolean
        Dim classname As String = Nothing
        Dim funcname As String = Nothing
        If Not strrseg(procname, classname, funcname, character.dot) Then
            Return False
        Else
            Return loadmethod(filename, classname, funcname, m)
        End If
    End Function
End Module
